home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / defoma / libdefoma-font.pl < prev    next >
Encoding:
Text File  |  2006-06-17  |  5.4 KB  |  269 lines
  1. sub hintfile_convert_hints {
  2.     my @ret = ();
  3.  
  4.     while (@_ > 0) {
  5.     my $line = shift(@_);
  6.     while ($line =~ /\\$/ && @_ > 0) {
  7.         $line =~ s/\\$/ /;
  8.         $line .= shift(@_);
  9.     }
  10.  
  11.     if ($line =~ /^[ \t]*([^= \t]+)[ \t]*=[ \t]*(.*)[ \t]*$/) {
  12.         my $hinttype = $1;
  13.         my @hints = split(/[ \t]+/, $2);
  14.  
  15.         push(@ret, "--$hinttype");
  16.         push(@ret, @hints) if (@hints > 0);
  17.     } elsif ($line =~ /^[ \t]*([^= \t]+)[ \t]*$/) {
  18.         my $hinttype = $1;
  19.         push(@ret, "--$hinttype");
  20.     }
  21.     }
  22.  
  23.     return @ret;
  24. }
  25.  
  26. sub hintfile_read {
  27.     my $hintfile = shift;
  28.  
  29.     my @file = readfile($hintfile);
  30.     unless (@file) {
  31.     printm("$hintfile: Unable to open, or empty.");
  32.     return undef;
  33.     }
  34.  
  35.     my @hints = ();
  36.     my $font = '';
  37.     my @l_font = ();
  38.     my @l_hints = ();
  39.     my @l_category = ();
  40.     my $lnum = 0;
  41.     my $category = '';
  42.     
  43.     while (@file) {
  44.     my $line = shift(@file);
  45.     $lnum++;
  46.     next if ($line =~ /^\#/);
  47.     
  48.     if ($line =~ /^begin[ \t]+([^ \t]+)/) {
  49.         if ($category eq '') {
  50.         printe("$hintfile: syntax error in line $lnum. ",
  51.                "'begin' before 'category'.");
  52.         return undef;
  53.         }
  54.         
  55.         if ($font ne '') {
  56.         printe("$hintfile: syntax error in line $lnum. ",
  57.                "Another 'begin' between 'begin' .. 'end'.");
  58.         return undef;
  59.         }
  60.  
  61.         $font = $1;
  62.         @hints = ();
  63.  
  64.         foreach my $lfont (@l_font) {
  65.         if ($font eq $lfont) {
  66.             printw("$hintfile: Serious warning in line $lnum. ",
  67.                "Duplicated font definition.");
  68.             last;
  69.         }
  70.         }
  71.     } elsif ($line =~ /^end[ \t]*$/) {
  72.         if ($font eq '') {
  73.         printe("$hintfile: syntax error in line $lnum. ",
  74.                "'end' without 'begin'.");
  75.         return undef;
  76.         } else {
  77.         my @lhints = hintfile_convert_hints(@hints);
  78.         my $lhintstr = (@lhints > 0) ? join(' ', @lhints) : '';
  79.  
  80.         push(@l_font, $font);
  81.         push(@l_hints, $lhintstr);
  82.         push(@l_category, $category);
  83.  
  84.         $font = '';
  85.         @hints = ();
  86.         }
  87.     } elsif ($line =~ /^category[ \t]+([^ \t]+)/) {
  88.         $category = $1;
  89.     } elsif ($line =~ /^obsolete[ \t]+([^ \t]+)/) {
  90.         if ($font ne '') {
  91.         printe("$hintfile: syntax error in line $lnum. ",
  92.                "'obsolete' between 'begin' .. 'end'.");
  93.         return undef;
  94.         }
  95.  
  96.         push(@l_font, $1);
  97.         push(@l_hints, '');
  98.         push(@l_category, 'obsoleted');
  99.     } elsif ($font ne '') {
  100.         push(@hints, $line);
  101.     }
  102.     }
  103.  
  104.     my $hashptr = {};
  105.     
  106.     my $cnt = @l_font;
  107.     
  108.     for (my $i = 0; $i < $cnt; $i++) {
  109.     $hashptr->{$l_font[$i]} = {};
  110.     $hashptr->{$l_font[$i]}->{category} = $l_category[$i];
  111.     $hashptr->{$l_font[$i]}->{hints} = $l_hints[$i];
  112.     }
  113.  
  114.     return $hashptr;
  115. }
  116.  
  117.  
  118.  
  119. sub com_register {
  120.     usage_and_exit if (@ARGV < 2);
  121.  
  122.     mylock(1);
  123.     init_all();
  124.     
  125.     my $ret = defoma_font_register(@ARGV);
  126.     $ret = $ret ? ERROR : 0;
  127.     
  128.     term_all();
  129.     mylock(0);
  130.     exit $ret;
  131. }
  132.  
  133. sub com_unregister {
  134.     usage_and_exit if (@ARGV < 2);
  135.     
  136.     mylock(1);
  137.     init_all();
  138.     
  139.     my $ret = defoma_font_unregister(@ARGV);
  140.     
  141.     term_all();
  142.     mylock(0);
  143.     exit $ret;
  144. }
  145.  
  146. sub com_reregister {
  147.     usage_and_exit if (@ARGV < 2);
  148.  
  149.     mylock(1);
  150.     init_all();
  151.     
  152.     my $ret = defoma_font_reregister(@ARGV);
  153.     
  154.     term_all();
  155.     mylock(0);
  156.     exit $ret;
  157. }
  158.  
  159. sub com_purge {
  160.     $Debian::Defoma::Id::Purge = 1;
  161.     com_unregister();
  162. }
  163.  
  164. sub com_all {
  165.     my $funcptr = shift;
  166.     my $hintfile = shift;
  167.     my $onefont = shift; # for <command>-one
  168.  
  169.     mylock(1);
  170.     init_all();
  171.     
  172.     my $hashptr = hintfile_read($hintfile);
  173.  
  174.     unless (defined($hashptr)) {
  175.     term_all();
  176.     mylock(0);
  177.     exit ERROR;
  178.     }
  179.  
  180.     if (defined($onefont) && ! exists($hashptr->{$onefont})) {
  181.     term_all();
  182.     mylock(0);
  183.     printw("$onefont isn't defined in $hintfile.");
  184.     exit ERROR;
  185.     }
  186.  
  187.     my ($i, $max, $category);
  188.     my @hints;
  189.     my $ret = 0;
  190.     
  191.     foreach my $font (keys(%{$hashptr})) {
  192.     next if (defined($onefont) && $font ne $onefont);
  193.     
  194.     @hints = split(' ', $hashptr->{$font}->{hints});
  195.     $category = $hashptr->{$font}->{category};
  196.  
  197.     $ret += &{$funcptr}($category, $font, @hints);
  198.     }
  199.     
  200.     $ret = $ret ? ERROR : 0;
  201.  
  202.     term_all();
  203.     mylock(0);
  204.     exit $ret;
  205. }
  206.  
  207. sub com_register_all {
  208.     usage_and_exit if (@ARGV == 0);
  209.     com_all(\&defoma_font_register, shift(@ARGV));
  210. }
  211.  
  212. sub com_unregister_all {
  213.     usage_and_exit if (@ARGV == 0);
  214.     com_all(\&defoma_font_unregister, shift(@ARGV));
  215. }
  216.  
  217. sub com_reregister_all {
  218.     usage_and_exit if (@ARGV == 0);
  219.     com_all(\&defoma_font_reregister, shift(@ARGV));
  220. }
  221.  
  222. sub com_purge_all {
  223.     $Debian::Defoma::Id::Purge = 1;
  224.     com_unregister_all();
  225. }
  226.  
  227. sub com_register_one {
  228.     usage_and_exit if (@ARGV < 2);
  229.     com_all(\&defoma_font_register, @ARGV);
  230. }
  231.  
  232. sub com_unregister_one {
  233.     usage_and_exit if (@ARGV < 2);
  234.     com_all(\&defoma_font_unregister, @ARGV);
  235. }
  236.  
  237. sub com_reregister_one {
  238.     usage_and_exit if (@ARGV < 2);
  239.     com_all(\&defoma_font_reregister, @ARGV);
  240. }
  241.  
  242. sub com_purge_one {
  243.     $Debian::Defoma::Id::Purge = 1;
  244.     com_unregister_one();
  245. }
  246.  
  247. sub main {
  248.     my $command = shift;
  249.     
  250.     my %fonthash = ( 'register' => \&com_register,
  251.              'unregister' => \&com_unregister,
  252.              'reregister' => \&com_reregister,
  253.              'purge' => \&com_purge,
  254.              'register-all' => \&com_register_all,
  255.              'unregister-all' => \&com_unregister_all,
  256.              'reregister-all' => \&com_reregister_all,
  257.              'purge-all' => \&com_purge_all,
  258.              'register-one' => \&com_register_one,
  259.              'unregister-one' => \&com_unregister_one,
  260.              'reregister-one' => \&com_reregister_one,
  261.              'purge-one' => \&com_purge_one );
  262.     
  263.     if (exists($fonthash{$command})) {
  264.     &{$fonthash{$command}}();
  265.     }
  266. }
  267.  
  268. 1;
  269.